//////////
// 定义设置清理：lambda/define/set/gensym/oblist/gc

#include <memory.h>
#include "../basic/operator.h"

Cell* op_lambda(Scheme *sc) {
	log(sc, "syntax/define", "op_lambda");
	sc->returnValue = make_closure(sc, sc->code, sc->env);
	log(sc, "syntax/define", "op_lambda");
	return pop_callstack(sc);
}

Cell* op_def0(Scheme *sc) {
	//(define var_name expr)
	Cell *x;

	log(sc, "syntax/define", "op_def0");
	//debug(sc);

	if (is_immutable(car(sc->code))) {
		sc->returnValue = make_default_exception(sc, "UNABLE_TO_ALTER_IMMUTABLE", "define: unable to alter immutable.");
		return pop_callstack(sc);
	}
	if (type_of(sc, car(sc->code), PAIR_TYPE)) {
		//形式1 (define (var_name arg ...) body)
		//例子 (define (fname arg1 arg2) (+arg1 arg2))可以通过这个分支 ，最后结果是闭包 ,这个被变换为 (define fname (lambda (arg1 arg2) (+ arg1 arg2))
		//形式2 (define (var_name . arg) body) //x为(var_name arg ...)  被变换为 (define fname (lambda arg body)
		x = caar(sc->code);
		sc->code = cons(sc, cell_lambda, cons(sc, cdar(sc->code), cdr(sc->code)));
	} else {
		x = car(sc->code);				//x为var_name
		sc->code = cadr(sc->code);		//sc->code为expr
	}

    //debug(sc);
	//if (IS_PARE(sc, sc->code)) {
	//	x->_type = PROCEDURE_TYPE;
	//}

	push_callstack(sc, cell_op_def1, G_NIL, x);
	sc->op = cell_op_eval;
	log(sc, "syntax/define", "op_def0");
	return G_TRUE;
}

Cell* op_def1(Scheme *sc) {
	/*
    Cell *x;

	//sc->code为var_name
	x = find_slot_in_env(sc, sc->env, sc->code, FALSE);	//在当前环境中查找这个符号var，并不是在全局环境中查找，而且不递归查找
	if (x != G_NIL) {
		set_slot_in_env(sc, x, sc->returnValue);
	} else {
		new_slot_in_env(sc, sc->code, sc->returnValue);
	}
    */
	log(sc, "syntax/define", "op_def1");

    Cell* r = define_variable(sc, sc->globalEnv, sc->code->_name, sc->returnValue);  //sc->env????
	//sc->code->_type = sc->returnValue->_type; ////added
	if (strcmp(sc->returnValue->_type, CLOSURE_TYPE) == 0) { //????
		sc->code->_type = CLOSURE_TYPE;
	} else {
		sc->code->_type = POINTER;
	}

    if (type_of(sc, r, EXCEPTION_TYPE)) {
        sc->returnValue = r;
    } else {
        sc->returnValue = sc->code;
    }

	log(sc, "syntax/define", "op_def1");
	return pop_callstack(sc);				//返回变量名
}


Cell* op_set0(Scheme *sc) {
	log(sc, "syntax/define", "op_set0");
	//形式 (set! var_name expr)
	Cell* var_name = car(sc->code);
	if (is_immutable(var_name))
		return make_default_exception_1(sc, "UNABLE_TO_ALTER_IMMUTABLE_VARIABLE", "set!: unable to alter immutable variable %s", cell2str(sc, var_name));
	push_callstack(sc, cell_op_set1, G_NIL, var_name);
	sc->code = cadr(sc->code); //sc->code结果为expr
	sc->op = cell_op_eval; //对expr进行求值
	log(sc, "syntax/define", "op_set0");
	return G_TRUE;
}

Cell* op_set1(Scheme *sc) {
	/*
    Cell *y;
	//sc->code为 var_name
	y = find_slot_in_env(sc, sc->env, sc->code, TRUE);
	if (y != G_NIL) {
		set_slot_in_env(sc, y, sc->returnValue);
		return pop_callstack(sc);
	} else {
		return make_default_exception_1(sc, "UNBOUND_VARIABLE", "set!: unbound variable: %s", cell2str(sc, sc->code));
	}
    */

	log(sc, "syntax/define", "op_set1");
    Cell* r = set_variable_value(sc, sc->env, sc->code->_name, sc->returnValue);
    sc->returnValue = r;
	log(sc, "syntax/define", "op_set1");
    return pop_callstack(sc);
}


// (gc)
Cell* op_gc(Scheme *sc) {
	log(sc, "syntax/define", "op_gc");
	gc(sc, G_NIL, G_NIL);
	sc->returnValue = G_TRUE;
	log(sc, "syntax/define", "op_gc");
	return pop_callstack(sc);
}

// (gc-verbose #t)
// (gc-verbose)
Cell* op_gcverb(Scheme *sc) {
	//int was = sc->gc_verbose;
	//sc->gc_verbose = (car(sc->args) != G_FALSE);
	//return s_return_helper(sc, (was) ? G_TRUE : G_FALSE);
	return G_TRUE;
}

void init_define_operators(Scheme *sc) {
	ADD_OPERATOR(sc, "$lambda", lambda);
	ADD_OPERATOR(sc, "$def0", def0);
	ADD_OPERATOR(sc, "$def1", def1);
	ADD_OPERATOR(sc, "$set0", set0);
	ADD_OPERATOR(sc, "$set1", set1);
	ADD_OPERATOR(sc, "gc", gc);
	ADD_OPERATOR(sc, "gc-verbose", gcverb);

	ADD_SYNTAX(sc, "lambda", lambda);
	ADD_SYNTAX(sc, "define", def0);
	ADD_SYNTAX(sc, "set!", set0);
}
